home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / CRS / crs03.d81 / datafile.sfx / datafile (.txt) next >
Commodore BASIC  |  1990-02-12  |  8KB  |  266 lines
  1. 10 REM DATAFILE 2.9 BY MIKE KONSHAK
  2. 12 POKE53280,13:POKE53281,11:PRINT"[158]":GOSUB16:IFX=0THENGOTO66
  3. 14 GOTO68
  4. 16 D$=CHR$(0):MR$=D$:DR$=D$:S=0:B1$=D$:PW=0:CW=0:B$=CHR$(32)
  5. 18 NC=0:NL=0:PG=0:F1=0:F2=0:F3=0:L$=D$:RL=0:SB$=D$:CR$=CHR$(13):HN$=D$:ID$=D$
  6. 20 A$=D$:C$=D$:T%=0:I$=D$:CK=0:I=0:J=0:K=0:L=0:M=0:N=0:RW=5:SF=0:Z=0:E$="EOF"
  7. 22 EN=0:EM$=D$:ET=0:ES=0:A1$=D$:A2$=D$:A3$=D$:S1$=D$:FL=0
  8. 23 MEM=30000:RETURN
  9. 24 DIMF$(F+1),T%(F+1),L%(F+1):RETURN
  10. 26 DIMREC$(R+1,F+1),ML$(9,4),PC(10),TT$(5),HC$(9),K%(R+1):RETURN
  11. 28 REM--GET
  12. 30 GETA$:IFA$=""THEN30
  13. 32 RETURN
  14. 34 REM--CREATE
  15. 36 IFCK<>0THENGOSUB394
  16. 38 PRINT"[147]          INITIALIZE DATAFILE          "
  17. 40 CLR:GOSUB16:INPUT"HOW MANY FIELDS IN EACH RECORD? 0 [157][157][157][157]";F:IFF=0THEN68
  18. 42 GOSUB24:FORI=1TOF
  19. 44 PRINT"FIELD #";I:PRINT"TITLE ? >                           "
  20. 46 PRINT"LENGTH? 0                           "
  21. 47 PRINT"";TAB(6);:INPUTF$(I):IFF$(I)=""THENF$(I)=">"
  22. 48 PRINTTAB(6);:INPUTL%(I):IFL%(I)=0THEN68
  23. 49 NEXTI
  24. 50 REM--COMPUTE # RECORDS
  25. 52 FORJ=0TOF:RL=RL+L%(J):NEXTJ:RL=RL+3*(F+1)+5:R=INT((MEM-12*(F+1)-2100)/RL)
  26. 54 PRINT" YOUR SELECTIONS WILL ALLOW APPROX"
  27. 56 PRINTR;"RECORDS.  A[146]CCEPT OR R[146]EJECT?"
  28. 58 GOSUB30:IFA$="R"THEN38
  29. 59 IFA$="A"THENGOSUB26:CK=1
  30. 60 FORI=1TOF:IFLEN(F$(I))>S1THENS1=LEN(F$(I))
  31. 62 NEXTI:GOTO68
  32. 64 REM MENU
  33. 66 PRINT"[147]  DATAFILE 2.9 BY MIKE KONSHAK ":GOTO70
  34. 68 PRINT"[147]            DATAFILE MENU              "
  35. 70 PRINT"     C[146]REATE NEW FILE  Q[146]UIT PROGRAM
  36. 72 [153]"     AWAITDD RECORD TO CURRENT FILE"
  37. 74 [153]"     MWAITODIFY RECORD IN CURRENT FILE"
  38. 76 [153]"     DWAITELETE RECORD IN CURRENT FILE"
  39. 78 [153]"     VWAITIEW FILE ON SCREEN
  40. 80 PRINT"     S[146]ORT RECORDS BY FIELD
  41. 82 [153]"     PWAITRINT RECORDS BY SELECTION
  42. 84 PRINT"     R[146]EAD OLD FILE FROM DISK"
  43. 86 PRINT"     W[146]RITE NEW FILE TO DISK
  44. 88 [153]"     @WAIT DISK DRIVE COMMANDS
  45. 90 PRINT"       PRESS THE APPROPRIATE KEY       "
  46. 92 PRINT"  THERE ARE";X;"RECORDS IN MEMORY"
  47. 94 IFR>0THENPRINT"  SPACE FOR";R-X;"MORE RECORDS[145]"
  48. 96 GOSUB30:IFA$="A"THENGOSUB350:IFFL=0THEN124
  49. 98 IFA$="M"THENGOSUB354:IFFL=0THEN244
  50. 100 IFA$="D"THENGOSUB354:IFFL=0THEN272
  51. 102 IFA$="C"THEN36
  52. 104 IFA$="R"THEN170
  53. 106 IFA$="P"THENGOSUB354:IFFL=0THEN358
  54. 108 IFA$="V"THENGOSUB354:IFFL=0THEN192
  55. 110 IFA$="W"THENGOSUB350:IFFL=0THEN144
  56. 112 IFA$="S"THENGOSUB354:IFFL=0THEN304
  57. 114 IFA$="Q"THEN342
  58. 116 IFA$="@"THEN462
  59. 118 IFFL<>0THENFL=0:GOTO68
  60. 120 GOTO96
  61. 122 REM--ADD RECORDS
  62. 124 FORI=X+1TOR:PRINT"[147] PRESS THE RETURN[146] KEY AFTER EACH ENTRY"
  63. 126 PRINT" PRESS RETURN[146] WITHOUT ANY ENTRY TO STOP"
  64. 128 PRINT" RECORD NUMBER ";I;""
  65. 130 FORN=1TOF
  66. 132 PRINTF$(N);"   >[157][157][157]";:INPUTREC$(I,N):IFREC$(I,N)=""THENREC$(I,N)=">"
  67. 134 IFLEN(REC$(I,N))>L%(N)THENGOSUB140:GOTO132
  68. 136 IFREC$(I,1)=">"THENX=I-1:CK=1:GOTO68
  69. 138 NEXTN:K%(I)=I:NEXTI:X=R:CK=1:GOTO68
  70. 140 PRINT"CANNOT EXCEED";L%(N);" CHARACTERS":RETURN
  71. 142 REM SAVE
  72. 144 PRINT"[147]ENTER NAME OF CURRENT FILE TO BE SAVED"
  73. 146 PRINT"(12 CHARACTERS MAX).  ANY AXISTING FILE"
  74. 148 PRINT"WITH THE SAME NAME WILL BE SCRATCHED."
  75. 150 PRINT"  ";NF$:INPUT"[145]";NF$:IFNF$=""THEN68
  76. 152 OPEN15,8,15:PRINT#15,"S0:DF] "+LEFT$(NF$,8)+"!OLD":GOSUB414:IFET=8THEN68
  77. 154 PRINT#15,"R0:DF] "+LEFT$(NF$,8)+"!OLD=DF] "+NF$:GOSUB414:IFET=8THEN68
  78. 156 OPEN5,8,5,"0:DF] "+NF$+",S,W":GOSUB414:IFET=8THEN68
  79. 158 PRINT#5,R;CR$;F;CR$;X:FORN=1TOF:PRINT#5,F$(N);CR$;L%(N):NEXTN
  80. 159 GOSUB414:IFET=8THEN68
  81. 160 FORI=1TOX:PRINT"SAVING RECORD #";I;"[145][145]"
  82. 162 FORN=1TOF:PRINT#5,REC$(K%(I),N):NEXTN:NEXTI:PRINT:GOSUB414:IFET=8THEN68
  83. 164 FORI=1TOX:PRINT" SAVING POINTERS";I;"[145][145]":PRINT#5,I:NEXTI
  84. 165 PRINT#5,E$:GOSUB414:IFET=8THEN68
  85. 166 CLOSE5:CLOSE15:CK=0:GOTO68
  86. 168 REM LOAD
  87. 170 IFCK<>0THENGOSUB394
  88. 172 CLR:GOSUB16:PRINT"[147] ENTER NAME OF FILE TO BE LOADED":INPUTNF$
  89. 173 IFNF$=""THEN68
  90. 174 OPEN15,8,15:OPEN5,8,5,"0:DF] "+NF$+",S,R":GOSUB414:IFET=8THEN68
  91. 175 IFEN=62THENGOSUB416:GOTO68
  92. 176 INPUT#5,R,F,X:GOSUB414:IFET=8THEN68
  93. 177 GOSUB24:GOSUB26:FORN=1TOF:INPUT#5,F$(N),L%(N):NEXTN:GOSUB414:IFET=8THEN68
  94. 178 FORI=1TOX:PRINT"READING RECORD #";I;"[145][145]"
  95. 180 FORN=1TOF:INPUT#5,REC$(I,N):NEXTN:NEXTI:PRINT:GOSUB414:IFET=8THEN68
  96. 182 FORI=1TOX:PRINT"READING POINTERS";I;"[145][145]":INPUT#5,K%(I):NEXTI
  97. 184 S=ST:IFS<>0THEN188
  98. 186 INPUT#5,E$:GOSUB414:IFET=8THEN68
  99. 188 CLOSE5:CLOSE15:GOTO60
  100. 190 REM VIEW
  101. 192 I=1
  102. 194 IFI=0THEN68
  103. 196 IFI>XTHEN68
  104. 198 PRINT"[147] RECORD NUMBER:"+STR$(I)+"  FILE:"+NF$+""
  105. 200 FORN=1TOF:PRINTF$(N);": ";REC$(K%(I),N):NEXTN
  106. 202 PRINT" N[146]EXT, L[146]AST, J[146]UMP, F[146]IND, E[146]XIT TO MENU"
  107. 204 GOSUB30:IFA$="N"THENI=I+1:GOTO194
  108. 206 IFA$="L"THENI=I-1:GOTO194
  109. 208 IFA$="J"THEN216
  110. 210 IFA$="F"THEN218
  111. 212 IFA$="E"THEN68
  112. 214 GOTO204
  113. 216 INPUT"JUMP TO RECORD NUMBER";I:GOTO194
  114. 218 PRINT"[147]    FIND RECORDS WITH COMMON ITEMS "
  115. 220 FORN=1TOF:PRINT" ";N;"[146] ";F$(N):NEXTN
  116. 222 INPUT"WHICH FIELD IS TO BE SEARCHED? 0 [157][157][157][157]";SF:IFSF=0THEN68
  117. 224 IFSF<1ORSF>FTHENPRINT"[145][145][145]":GOTO222
  118. 226 PRINT"ENTER COMMON ITEM[146] ":PRINT"(THE ENTIRE STRING IS NOT REQUIRED)"
  119. 228 PRINT"";F$(SF);"[146] ";:INPUTT$
  120. 230 FORI=1TOX:PRINT"SEARCHING RECORD";I;"[145][145]"
  121. 232 IFT$=LEFT$(REC$(K%(I),SF),LEN(T$))THEN236
  122. 234 GOTO240
  123. 236 PRINT"[147] RECORD #";I;"":FORN=1TOF:PRINTF$(N);": ";REC$(K%(I),N):NEXTN
  124. 238 PRINT" N[146]EXT RECORD":GOSUB30
  125. 240 NEXTI:GOTO68
  126. 242 REM MODIFY
  127. 244 PRINT"[147] MODIFY WHICH RECORD? ENTER #[146] OR A[146]LL":INPUTMR$:IFMR$=D$THEN68
  128. 246 IFMR$="A"THENMR$=D$:GOTO254
  129. 248 I=VAL(MR$):MR$=D$
  130. 250 IFI>XTHENGOSUB348:GOTO244
  131. 252 GOSUB256:GOTO68
  132. 254 FORI=1TOX:GOSUB256:NEXTI:GOTO68
  133. 256 PRINT"[147]TO MODIFY RECORD NUMBER";I;", MAKE CHANGES"
  134. 258 PRINT"AS EACH FIELD IS DISPLAYED, THEN RETURN[146]"
  135. 260 FORN=1TOF:PRINTF$(N)":":PRINT"   ";REC$(K%(I),N)
  136. 261 IFLEN(REC$(K%(I),N))>36THENPRINT"[145]";
  137. 262 PRINT"[145] ";:INPUTREC$(K%(I),N)
  138. 264 IFLEN(REC$(K%(I),N))>L%(N)THENGOSUB140:GOTO260
  139. 266 IFREC$(K%(I),N)=""THENREC$(K%(I),N)=">"
  140. 268 NEXTN:CK=1:RETURN
  141. 270 REM DELETE
  142. 272 PRINT"[147] DELETE WHICH RECORD? ENTER #[146] OR A[146]LL"
  143. 274 INPUTDR$:IFDR$=D$THEN68
  144. 276 IFDR$="A"THENDR$=D$:GOTO282
  145. 278 I=VAL(DR$):DR$=D$:IFI>XTHENGOSUB348:GOTO274
  146. 280 GOSUB284:GOTO68
  147. 282 FORI=1TOX:GOSUB284:NEXTI:GOTO68
  148. 284 PRINT"[147] TO DELETE RECORD NUMBER";I;", PRESS"
  149. 286 PRINT" SHIFT[146] D[146], PRESS SPACE BAR[146] TO ADVANCE"
  150. 288 FORN=1TOF:PRINTF$(N);"   ";REC$(K%(I),N):NEXTN
  151. 290 GOSUB30:IFA$="[196]"THEN294:REM SHIFTED D
  152. 292 CK=1:RETURN
  153. 294 PRINT"DELETING RECORD";I:PRINT"RECORDS MAY NOW BE OUT OF ORDER"
  154. 296 FORN=1TOF:REC$(K%(I),N)=REC$(X,N):REC$(X,N)="":NEXTN
  155. 298 FORJ=1TOX:IFK%(J)=XTHENK%(J)=K%(X):K%(X)=0:X=X-1:GOTO292
  156. 300 NEXTJ
  157. 302 REM SORT
  158. 304 PRINT"[147]     SORT RECORDS IN ASCENDING ORDER   "
  159. 306 FORN=1TOF:PRINT" ";N;"[146] ";F$(N):NEXTN
  160. 308 INPUT"WHICH FIELD IS TO BE SORTED? 0 [157][157][157][157]";SF:IFSF=0THEN68
  161. 310 IFSF>FTHENPRINT"[145][145][145]":GOTO308
  162. 312 PRINT" PLEASE WAIT[146]":M=X
  163. 314 M=INT(M/2):IFM=0THENCK=1:GOTO68
  164. 316 J=1:K=X-M
  165. 318 I=J
  166. 320 L=I+M
  167. 322 PRINT"SORTING       [157][157][157][157][157]";I;"[145]"
  168. 324 IFREC$(K%(I),SF)<=REC$(K%(L),SF)THEN328
  169. 326 T%(N)=K%(I):K%(I)=K%(L):K%(L)=T%(N):I=I-M:IFI>0THEN320
  170. 328 J=J+1:IFJ>KTHEN314
  171. 330 GOTO318
  172. 332 REM QUIT
  173. 334 PRINT"[147] [150]YOU HAVE NOT SAVED YOUR CHANGES![158]"
  174. 336 PRINT" DOYOU REALLY WANT TO QUIT? Y[146] OR N[146]
  175. 338 [141]30:[139]A$[178]"Y"[167]344
  176. 340 [137]68
  177. 342 [139]CK[179][177]0[167]334
  178. 344 [153]"LOADDATAFILE TERMINATED":[128]
  179. 346 [143] ERROR CHECK
  180. 348 [153]" DEFNO SUCH RECORD EXISTSSYS":[142]
  181. 350 [139]R[177]0[167][142]
  182. 352 [153]" DEF    NO RECORDS OR FILES IN MEMORY     SYSWAIT "
  183. 353 [129]I[178]1[164]500:[130]I:FL[178]1:[142]
  184. 354 [139]X[177]0[167][142]
  185. 355 [141]352:[142]
  186. 356 [143] LOAD PRINT
  187. 358 [153]"LOAD             PRINTER MAIN MENU         "
  188. 360 [153]"  PRINT RECORDS USING:
  189. 362 PRINT"      R[146]EPORTS AND LISTS
  190. 364 [153]"      MWAITAILING LABELS
  191. 366 PRINT"      U[146]SER DEFINED SUBPROGRAM
  192. 368 [153]"      EWAITXIT TO MAIN MENU
  193. 370 PRINT"       PRESS THE APPROPRIATE KEY       "
  194. 372 GOSUB30:IFA$="R"THEN384
  195. 374 IFA$="E"THEN68
  196. 376 IFA$="U"THEN386
  197. 378 IFA$="M"THEN382
  198. 380 GOTO372
  199. 382 PRINT"[147]   LOADING MAILING LABEL SUBPROGRAM":LOAD"DFMAIL",8
  200. 384 PRINT"[147]   LOADING REPORT/LISTING SUBPROGRAM":LOAD"DFREPORT",8
  201. 385 REM ?"[147]   LOADING CALCULATIONS SUBPROGRAM":LOAD"DFCALC",8
  202. 386 PRINT"[147] ENTER NAME OF SUBPROGRAM"
  203. 388 PRINT"";SB$:INPUT"[145]";SB$:IFSB$=D$THEN358
  204. 389 OPEN15,8,15:OPEN5,8,5,"0:"+SB$+",P,R":GOSUB414:IFEN=62THENGOSUB416:GOTO358
  205. 390 CLOSE5:CLOSE15:LOADSB$,8
  206. 392 REM WARNING
  207. 394 PRINT"[147] [150]THIS WILL DESTROY THE FILE IN MEMORY![158]"
  208. 396 PRINT" SAVE THE FILE FIRST? Y[146] OR N[146]":GOSUB30:IFA$="N"THENRETURN
  209. 398 GOTO68
  210. 400 REM NEW DISK
  211. 402 PRINT"[147] THIS WILL ERASE THE DISK![158]"
  212. 403 PRINT" ARE YOU SURE? Y[146] OR N[146]
  213. 404 [141]30:[139]A$[178]"N"[167]68
  214. 406 [139]A$[179][177]"Y"[167]68
  215. 408 [133]" DISK NAME,IDWAIT";HN$,ID$:[139]HN$[178]D$[167]68
  216. 410 [159]15,8,15:[152]15,"NEW0:"[170]HN$[170]","[170]ID$:[141]414:[139]ET[178]8[167]462
  217. 411 [160]15:[137]462
  218. 412 [143] DISK ERROR
  219. 414 [132]15,EN,EM$,ET,ES:[139](EN[179]20)[176](EN[178]62)[167]ET[178]0:[142]
  220. 416 [153]" DEFDISK ERRORWAIT"EN"CMD, "EM$","ET"CMD,"ES"SYS":ET[178]8
  221. 418 [153]" PRESS ANY KEYWAIT TO RETURN TO MENU":[141]30:[160]5:[160]15:[142]
  222. 420 [143] DIRECTORY
  223. 422 [159]15,8,15:[159]5,8,0,"$0":[153]"LOAD":[141]414:[139]ET[178]8[167]462
  224. 424 [161]#5,A1$,A2$
  225. 426 [161]#5,A1$,A2$
  226. 428 [161]#5,A1$,A2$
  227. 430 [139]A1$[179][177]""[167]A0[178][198](A1$)
  228. 432 [139]A2$[179][177]""[167]A0[178]A0[170][198](A2$)[172]256
  229. 434 [153][202]([196](A0),2);[163]3);
  230. 436 [161]#5,A2$:[139]ST[179][177]0[167]454
  231. 438 [139]A2$[179][177][199](34)[167]436
  232. 440 [161]#5,A2$:[139]A2$[179][177][199](34)[167][153]""A2$"WAIT";:[137]440
  233. 442 [161]#5,A2$:[139]A2$[178][199](32)[167]442
  234. 444 [153][163]20);:A3$[178]""
  235. 446 A3$[178]A3$[170]A2$:[161]#5,A2$:[139]A2$[179][177]""[167]446
  236. 448 [153][200](A3$,3)
  237. 450 [161]A$:[139]A$[179][177]""[167][141]458
  238. 452 [139]ST[178]0[167]426
  239. 454 [153]" BLOCKS FREE";:A0[178]0
  240. 456 [160]5:[160]15:[153][163]25)"PRESS ANY KEYWAIT":[141]30:[137]462
  241. 458 [141]30:[142]
  242. 460 [143] DISK COMMANDS
  243. 462 [153]"LOAD         DISK COMMANDS MENU           "
  244. 464 [153]"         $WAIT DISK DIRECTORY
  245. 466 PRINT"         F[146]ORMAT A BLANK DISK
  246. 468 [153]"         SWAITCRATCH A SEQ FILE
  247. 470 PRINT"         R[146]ENAME A SEQ FILE
  248. 472 [153]"         EWAITXIT TO MAIN MENU
  249. 474 PRINT"       PRESS THE APPROPRIATE KEY       "
  250. 476 GOSUB30:MR$=D$:DR$=D$:IFA$="$"THEN422
  251. 478 IFA$="F"THEN402
  252. 480 IFA$="S"THENGOSUB498:GOTO488
  253. 482 IFA$="E"THEN68
  254. 484 IFA$="R"THENGOSUB498:GOTO493
  255. 486 GOTO476
  256. 488 INPUT" SCRATCH FILE NAME [146]";DR$:IFDR$=D$THEN462
  257. 490 OPEN15,8,15:OPEN5,8,5,"0:"+DR$+",S,R":GOSUB414:IFET=8THEN462
  258. 492 CLOSE5:PRINT#15,"S0:"+DR$+:CLOSE15:GOTO462
  259. 493 INPUT" RENAME OLD FILE[146]";DR$:IFDR$=D$THEN462
  260. 494 INPUT"     TO NEW FILE [146]";MR$:IFMR$=D$THEN462
  261. 495 OPEN15,8,15:OPEN5,8,5,"0:"+DR$+",S,R":GOSUB414:IFET=8THEN462
  262. 496 CLOSE5:PRINT#15,"R0:"+MR$+"="+DR$:OPEN5,8,5:GOSUB414:IFET=8THEN462
  263. 497 CLOSE5:CLOSE15:GOTO462
  264. 498 PRINT"[147] ENTER FILE NAMES EXACTLY AS SHOWN"
  265. 499 PRINT" ON THE DIRECTORY":RETURN
  266.